home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / gfx / 3d / irit50src.lha / irit5 / irit / irit.el < prev    next >
Encoding:
Text File  |  1995-01-01  |  11.7 KB  |  301 lines
  1. ; 
  2. ; irit.el - Definitions of IRIT mode for emacs editor.
  3. ; 
  4. ; Author:    Gershon Elber
  5. ;         Computer Science Dept.
  6. ;         University of Utah
  7. ; Date:    Tue May 14 1991
  8. ; Copyright (c) 1991, Gershon Elber
  9. ;
  10. ; This file defines an environment to run edit and execute IRIT programs.
  11. ; Such a program should have a '.irt' extension in order it to be in
  12. ; irit-mode major mode. Several new functions are provided to communicate
  13. ; between the editted file and the solid modeller:
  14. ;
  15. ; 1. send-line-to-irit - sends a single line to the solid modeller for
  16. ;    execution. A line is defined from current position to the next
  17. ;    semicolon ';'. If however several commands exists on the same line
  18. ;    they will all be send as one line.
  19. ;    Bounded to Meta-E by default.
  20. ; 2. send-region-to-irit - sends the region from the current mark (mark-marker)
  21. ;    to current position (point-marker) to the solid modeller. This function
  22. ;    is convenient for sending a large block of commands.
  23. ;    Bounded to Meta-R by default.
  24. ; 3. send-mini-buffer-to-irit - sends a line retrieved via the mini buffer to
  25. ;    the solid modeller for execution. The line is appended with a new line
  26. ;    and is echoed to the irit-solid-modeller buffer if irit-echo-program.
  27. ;    Bounded to Meta-S by default.
  28. ;
  29. ; Both functions checks for existance of a buffer named irit-solid-modeller
  30. ; and a process named "irit" hooked to it, and will restart a new process
  31. ; or buffer if none exists. The program to execute as process "irit" is
  32. ; defined by the irit-program constant below.
  33. ;
  34.  
  35. (defvar irit-program "irit"
  36.   "*The executable to run for irit-solid-modeller buffer.")
  37.  
  38. (defvar irit-echo-program nil
  39.   "*Control echo of executed commands to irit-solid-modeller buffer.")
  40.  
  41. (defvar irit-mode-map nil "")
  42. (if irit-mode-map
  43.     ()
  44.   (setq irit-mode-map (make-sparse-keymap))
  45.   (define-key irit-mode-map "\M-s" 'send-mini-buffer-to-irit)
  46.   (define-key irit-mode-map "\M-e" 'send-line-to-irit)
  47.   (define-key irit-mode-map "\M-r" 'send-region-to-irit))
  48.  
  49. (define-key c-mode-map "\M-o" 'make-irit-c-function)
  50. (define-key c-mode-map "\M-p" 'overwrite-mode)
  51.  
  52. ;;;
  53. ;;; Define the irit-mode
  54. ;;;
  55. (defun irit-mode ()
  56.   "Major mode for editing and executing IRIT files.
  57.  
  58. see send-line-to-irit and send-region-to-irit for more."
  59.   (interactive)
  60.   (use-local-map irit-mode-map)
  61.   (setq major-mode 'irit-mode)
  62.   (setq mode-name "Irit")
  63.   (run-hooks 'irit-mode-hook))
  64.  
  65. ;;;
  66. ;;; Define send-min-buffer-to-irit - send one line prompt for at the mini
  67. ;;; buffer, to the irit buffer.
  68. ;;;
  69. (defun send-mini-buffer-to-irit ()
  70.   "Sends one line of code from mini-buffer to the IRIT program.
  71.  
  72. The IRIT solid modeller buffer name is irit-solid-modeller and the 
  73. process name is 'irit'. If none exists, a new one is created.
  74.  
  75. The name of the irit program program to execute is stored in irit-program
  76. and may be changed."
  77.   (interactive)
  78.   (if (equal major-mode 'irit-mode)
  79.     (progn
  80.       (make-irit-buffer)     ; In case we should start a new one.
  81.       (let* ((crnt-buffer (buffer-name))
  82.          (string-copy (read-from-minibuffer "Irit> ")))
  83.     (switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
  84.     (end-of-buffer)
  85.     (if irit-echo-program
  86.       (insert string-copy))
  87.     (if (not (pos-visible-in-window-p))
  88.       (recenter 3))
  89.     (process-send-string "irit" string-copy)
  90.     (process-send-string "irit" "\n")
  91.     (switch-to-buffer-other-window (get-buffer crnt-buffer))))
  92.     (message "Should be invoked in irit-mode only.")))
  93. ;;;
  94. ;;; Define send-line-to-irit - send from current cursor position to next
  95. ;;; semicolon detected.
  96. ;;;
  97. (defun send-line-to-irit ()
  98.   "Sends one line of code from current buffer to the IRIT program.
  99.  
  100. Use to execute a line in the IRIT solid modeller. A line is anything
  101. that is terminated by a semicolon, but is at least one line of text so
  102. multiple commands per line (with several semicolons) are still
  103. considered a single line.
  104.  
  105. The IRIT solid modeller buffer name is irit-solid-modeller and the 
  106. process name is 'irit'. If none exists, a new one is created.
  107.  
  108. The name of the irit program program to execute is stored in irit-program
  109. and may be changed."
  110.   (interactive)
  111.   (if (equal major-mode 'irit-mode)
  112.     (progn
  113.       (make-irit-buffer)        ; In case we should start a new one.
  114.       (beginning-of-line)
  115.       (let ((start-mark (point-marker)))
  116.     (search-forward ";")
  117.     (let ((end-one-mark (point-marker)))
  118.       (goto-char start-mark)
  119.       (beginning-of-line)
  120.       (next-line 1)
  121.       (let* ((crnt-buffer (buffer-name))
  122.              (end-two-mark (point-marker))
  123.              (end-max-mark (max end-one-mark end-two-mark))
  124.          (string-copy (buffer-substring start-mark end-max-mark)))
  125.         (switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
  126.         (end-of-buffer)
  127.         (if irit-echo-program
  128.           (insert string-copy))
  129.         (set-marker (process-mark (get-process "irit")) (point-marker))
  130.         (if (not (pos-visible-in-window-p))
  131.           (recenter 3))
  132.         (switch-to-buffer-other-window (get-buffer crnt-buffer))
  133.         (process-send-region "irit" start-mark end-max-mark)
  134.         (goto-char end-max-mark)
  135.         (if (equal "\n" (buffer-substring (point-marker)
  136.                           (+ 1 (point-marker))))
  137.           (process-send-string "irit" "\n"))  
  138.         (if (> end-one-mark end-two-mark)
  139.           (forward-char 1))))))
  140.     (message "Should be invoked in irit-mode only.")))
  141.  
  142. ;;;
  143. ;;; Define send-region-to-irit - send from current cursor position to
  144. ;;; current marker.
  145. ;;;
  146. (defun send-region-to-irit ()
  147.   "Sends a region of code from current buffer to the IRIT program.
  148.  
  149. When this function is invoked on an IRIT file it send the region from current
  150. point to current mark to the irit solid modeller.
  151.  
  152. The IRIT solid modeller buffer name is irit-solid-modeller and the
  153. process name is 'irit'. If none exists, a new one is created.
  154.  
  155. The name of the irit program program to execute is stored in irit-program
  156. and may be changed."
  157.   (interactive)
  158.   (if (equal major-mode 'irit-mode)
  159.     (progn
  160.       (make-irit-buffer)     ; In case we should start a new one.
  161.       (copy-region-as-kill (mark-marker) (point-marker))
  162.       (let ((crnt-buffer (buffer-name)))
  163.     (switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
  164.     (end-of-buffer)
  165.     (if irit-echo-program
  166.       (yank))
  167.     (set-marker (process-mark (get-process "irit")) (point-marker))
  168.     (if (not (pos-visible-in-window-p))
  169.       (recenter 3))
  170.     (switch-to-buffer-other-window (get-buffer crnt-buffer))
  171.     (process-send-region "irit" (mark-marker) (point-marker))))
  172.     (message "Should be invoked in irit-mode only.")))
  173.  
  174. ;;;
  175. ;;; Switch to "irit-solid-modeller" buffer if exists. If not, creates one and
  176. ;;; execute the program defined by irit-program.
  177. ;;;
  178. (defun make-irit-buffer ()
  179.   "Switch to irit-solid-modeller buffer or create one if none exists"
  180.   (interactive)
  181.   (if (not (get-process "irit"))
  182.     (start-process "irit" "irit-solid-modeller" irit-program)))
  183.  
  184. ;;;
  185. ;;; Autoload irit-mode on any file with irt extension. 
  186. ;;;
  187. (setq auto-mode-alist (append '(("\\.irt$" . irit-mode))
  188.                   auto-mode-alist))
  189.  
  190. ;;;
  191. ;;; Gets a single function's parameter containing both type andname and
  192. ;;; isolate the parametr's name out of it.
  193. ;;;
  194. (defun make-irit-c-isolate-var-name (type-and-name)
  195.   (let* ((match1 (string-match "[^\*     ]+" type-and-name))
  196.      (match2 (string-match "[\[     ]+" type-and-name match1))
  197.      (match3 (string-match "[^\*     ]+" type-and-name match2))
  198.      (match4 (string-match "[\[     ]+" type-and-name match3)))
  199.     (if match3
  200.       (substring type-and-name match3 (if match4
  201.                     match4
  202.                     (length type-and-name)))
  203.       (substring type-and-name match1 (if match2
  204.                     match2
  205.                     (length type-and-name))))))
  206.  
  207. ;;;
  208. ;;; Given a whole describing the arguments, split it into the individual
  209. ;;; parameters by searching for commas and close parenthesis.
  210. ;;;
  211. (defun make-irit-c-func-parse-args (args)
  212.   (if (string-match "([     ]*void[     ]*)" args)
  213.     nil
  214.     (let ((match (string-match "[,)]" args)))
  215.       (if match
  216.     (cons (make-irit-c-isolate-var-name (substring args 1 match))
  217.           (make-irit-c-func-parse-args
  218.                          (substring args (+ match 1) (length args))))))))
  219.  
  220. ;;;
  221. ;;; Insert a list describing the arguments into the current buffer.
  222. ;;;
  223. (defun make-irit-c-func-ins-params (args term-ch)
  224.   (if args
  225.     (progn
  226.       (insert (concat "*   " (car args)))
  227.       (insert-char ?: 1)
  228.       (insert-char ?  (- 72 (length (car args))))
  229.       (insert term-ch)
  230.       (make-irit-c-func-ins-params (cdr args) term-ch))))
  231.  
  232. ;;;
  233. ;;; Filters out trailing spaces if it is not a pointer (no *)
  234. ;;;
  235. (defun make-irit-c-func-retval (retval)
  236.   (let* ((match1 (string-match "*+" retval))
  237.      (match2 (string-match "[     ]+" retval)))
  238.     (if match1
  239.       retval
  240.       (if match2
  241.         (substring retval 0 match2)
  242.     retval))))
  243.  
  244. ;;;
  245. ;;; Make a skeleton header for an IRIT C source function.
  246. ;;;
  247. (defun make-irit-c-function ()
  248.   "Creates a sketelon for a C function for the IRIT solid modeler C code"
  249.   (interactive)
  250.   (if (equal major-mode 'c-mode)
  251.     (progn
  252.       (let* ((func-proto (read-from-minibuffer "Function Prototype: "))
  253.          (match1 (string-match "[     ]+" func-proto))
  254.          (match2 (string-match "[^*     ]+" func-proto match1))
  255.          (match3 (string-match "[     ]+" func-proto match2))
  256.          (match4 (string-match "[^*     ]+" func-proto match3))
  257.          (match5 (string-match "(" func-proto))
  258.          (ret-val (if (and match3 (< match3 match5))
  259.             (make-irit-c-func-retval (substring func-proto match2
  260.                                           match4))
  261.             (make-irit-c-func-retval (substring func-proto 0
  262.                                                                       match2))))
  263.          (term-ch (if (string-match "static" (substring func-proto 0 match1))
  264.             "*\n"
  265.             "M\n"))
  266.          (func-name (if (and match3 (< match3 match5))
  267.               (substring func-proto match4 match5)
  268.               (substring func-proto match2 match5)))
  269.          (args (make-irit-c-func-parse-args
  270.             (substring func-proto match5 (length func-proto)))))
  271.         (insert "/*****************************************************************************\n")
  272.         (insert (concat "* DESCRIPTION:                                                               " term-ch))
  273.         (insert (concat "*                                                                            " term-ch))
  274.         (insert (concat "*                                                                            " term-ch))
  275.         (insert "*                                                                            *\n")
  276.         (insert (concat "* PARAMETERS:                                                                " term-ch))
  277.     (if args
  278.       (make-irit-c-func-ins-params args term-ch)
  279.       (insert (concat "*   None                                                                     " term-ch)))
  280.         (insert "*                                                                            *\n")
  281.         (insert (concat "* RETURN VALUE:                                                              " term-ch))
  282.     (insert (concat "*   " ret-val ))
  283.     (if (string-match "void" ret-val)
  284.       (insert-char ?  (- 73 (length ret-val)))
  285.       (progn
  286.         (insert-char ?: 1)
  287.         (insert-char ?  (- 72 (length ret-val)))))
  288.     (insert term-ch)
  289.         (insert (concat "*                                                                            " term-ch))
  290.         (insert "*                                                                            *\n")
  291.     (if (not (string-match "static" (substring func-proto 0 match1)))
  292.       (progn
  293.         (insert (concat "* KEYWORDS:                                                                  " term-ch))
  294.         (insert (concat "*   " func-name))
  295.         (insert-char ?  (- 73 (length func-name)))
  296.         (insert term-ch)))
  297.         (insert (concat "*                                                                            " term-ch))
  298.         (insert "*****************************************************************************/\n")
  299.     (insert (concat func-proto "\n{\n}\n\n"))))
  300.     (message "Should be invoked in C-mode only.")))
  301.